Bubka 15/Bubka 15.iso/utility/win/msch126i.lzh/Src/ClassMdl.bas

BASIC Source File | 2001-11-27 | 30.9 KB | 1,162 lines

Attribute VB_Name = "ClassMdl"
Option Explicit

Public Const FILTER_ALL = "æSé─é╠âtâ@âCâï" & vbNullChar & "*.*" & vbNullChar
Public Const FILTER_EXE = "Ä└ìsâtâ@âCâï" & vbNullChar & "*.exe;*.com" & vbNullChar
Public Const FILTER_TXT = "âeâLâXâgâtâ@âCâï" & vbNullChar & "*.doc;*.txt" & vbNullChar
Public Const FILTER_IMG = "âCâüü[âWâtâ@âCâï" & vbNullChar & "*.bmp;*.jpg" & vbNullChar

Public Const FILTER_PROGRAM = FILTER_EXE & FILTER_ALL

Private mGetErrorNum As Long
'
'EXEâtâ@âCâïé╠âRâüâôâgé≡ĵô╛é╖éΘè╓Éö
'
Public Function GetFileComment(ByVal strExecuteFile As String) As String
    Dim CFile As ClsFile
    Set CFile = New ClsFile

    With CFile
        .strFileName = strExecuteFile
        .GetExecuteInfo
        GetFileComment = .Comment
    End With

    Set CFile = Nothing
End Function
'
'âtâ@âCâïé╠Äφù▐é≡ĵô╛
'
Public Function GetFileTypeInfo(ByVal strFileName As String) As String
    Dim CArcOp As ClsArcOp
    Set CArcOp = New ClsArcOp

    GetFileTypeInfo = CArcOp.GetFileTypeEx(strFileName)

    Set CArcOp = Nothing
End Function
'
'Iniâtâ@âCâïé⌐éτâfü[â^é≡ĵô╛(ò╢ÄÜù±î^)
'
Public Function IniReadByString(ByVal Section As String, ByVal EntryName As String) As String
    On Error GoTo ErrLine
    Dim CIni As ClsIniRW
    Set CIni = New ClsIniRW

    IniReadByString = CIni.ReadINIData(Section, EntryName)

    Set CIni = Nothing
    Exit Function
ErrLine:
    'MsgBox "âGâëü[:IniReadByString , " & _
           "âZâNâVâçâô:" & Section & _
           " âGâôâgâèü[âlü[âÇ:" & EntryName, _
           vbInformation, _
           "âGâëü[:IniReadByString"
    IniReadByString = ""
End Function
'
'Iniâtâ@âCâïé⌐éτâfü[â^é≡ĵô╛(Æ╖É«Éöî^)
'
Public Function IniReadByLong(ByVal Section As String, ByVal EntryName As String) As Long
    On Error GoTo ErrLine
    Dim CIni As ClsIniRW
    Set CIni = New ClsIniRW

    IniReadByLong = CIni.ReadINIData(Section, EntryName)

    Set CIni = Nothing
    Exit Function
ErrLine:
    'MsgBox "âGâëü[:IniReadByLong , " & _
           "âZâNâVâçâô:" & Section & _
           " âGâôâgâèü[âlü[âÇ:" & EntryName, _
           vbInformation, _
           "âGâëü[:IniReadByLong"
    IniReadByLong = 0
End Function
'
'Iniâtâ@âCâïé╔Åæé½ì₧é▌
'
Public Function IniWrite(ByVal Section As String, ByVal EntryName As String, ByVal Value As String) As Boolean
    On Error GoTo ErrLine
    Dim CIni As ClsIniRW
    Set CIni = New ClsIniRW

    Call CIni.WriteINIData(Section, EntryName, Value)
    IniWrite = True

    Set CIni = Nothing
    Exit Function
ErrLine:
    MsgBoxEx "âGâëü[:INIWrite , " & "âZâNâVâçâô:" & Section & _
             "âGâôâgâèü[âlü[âÇ:" & EntryName, vbInformation, _
             "âGâëü[:INIWrite"
    IniWrite = False
End Function
Public Sub FileExecute(ByVal strFileName As String, ByVal hWnd As Long)
    Dim CShell As ClsShell
    Set CShell = New ClsShell

    With CShell
        .strFileName = strFileName
        .TargethWnd = hWnd
        .ExecuteFile
    End With

    Set CShell = Nothing
End Sub
'
'æ╬Å█âtâ@âCâïé╠û╝æOé≡ò╧ìXé╡é▄é╖üB(API)
'
Public Function FileRename(ByVal hWnd As Long, ByVal strFileName As String, ByVal BeforeName As String) As Long
    Dim CShell As ClsShell
    Set CShell = New ClsShell
    With CShell
        .strFileName = strFileName
        .TargethWnd = hWnd
        FileRename = .ShellRename(BeforeName)
    End With

    Set CShell = Nothing
End Function
'
'æ╬Å█âtâ@âCâïé≡ìφÅ£é╡é▄é╖üB(âSâ~öáìsé½,API)
'
Public Sub FileDelete(ByVal hWnd As Long, ByVal strFileName As String)
    Dim CShell As ClsShell
    Set CShell = New ClsShell

    With CShell
        .strFileName = strFileName
        .TargethWnd = hWnd
        .ShellDelete
    End With

    Set CShell = Nothing
End Sub
'
'âtâ@âCâïé╠âvâìâpâeâBé≡ò\Īé╡é▄é╖üB(òíÉöûóæ╬ë₧)
'
Public Sub FileProperty(ByVal hWnd As Long, ByVal strFileName As String)
    Dim CShell As ClsShell
    Set CShell = New ClsShell

    With CShell
        .strFileName = strFileName
        .TargethWnd = hWnd
        .ShellProperty
    End With

    Set CShell = Nothing
End Sub
'
'îƒì⌡ëµû╩é≡Åoé╡é▄é╖üB
'
Public Sub FileSearch(ByVal hWnd As String, ByVal strFileName As String)
    Dim CShell As ClsShell
    Set CShell = New ClsShell

    With CShell
        .strFileName = strFileName
        .TargethWnd = hWnd
        .SearchFilePath
    End With

    Set CShell = Nothing
End Sub
'
'WindowsâtâHâïâ_é╠ê╩Æué≡ĵô╛é╡é▄é╖üB
'
Public Property Get GetWindowsPath(Optional ByVal blnSlash As Boolean = True) As String
    Dim CPath As ClsPath
    Set CPath = New ClsPath
    If blnSlash = True Then
        GetWindowsPath = CPath.GetWindowsDir & "\"
    Else
        GetWindowsPath = CPath.GetWindowsDir
    End If
    Set CPath = Nothing
End Property
'
'SystemâtâHâïâ_é╠ê╩Æué≡ĵô╛é╡é▄é╖üB
'
Public Property Get GetSystemPath(Optional ByVal blnSlash As Boolean = True) As String
    Dim CPath As ClsPath
    Set CPath = New ClsPath
    If blnSlash = True Then
        GetSystemPath = CPath.GetSystemDir & "\"
    Else
        GetSystemPath = CPath.GetSystemDir
    End If
    Set CPath = Nothing
End Property
'
'TempâtâHâïâ_é╠ê╩Æué≡ĵô╛é╡é▄é╖üB
'
Public Property Get GetTempPath(Optional ByVal blnSlash As Boolean = True, Optional ByVal blnmschTmp As Boolean = False) As String
    Dim CPath As ClsPath
    Set CPath = New ClsPath
    If blnSlash = True Then
        If blnmschTmp = False Then
            GetTempPath = CPath.GetTempDir
        Else
            GetTempPath = CPath.GetTempDir & "mschtmp\"
        End If
    Else
        If blnmschTmp = False Then
            GetTempPath = Mid$(CPath.GetTempDir, 1, Len(CPath.GetTempDir) - 1)
        Else
            GetTempPath = CPath.GetTempDir & "mschtmp"
        End If
    End If

    Set CPath = Nothing
End Property
'
'Program FilesâtâHâïâ_é╠ê╩Æué≡ĵô╛é╡é▄é╖üB
'
Public Property Get GetProgramFilesPath(Optional ByVal blnSlash As Boolean = True) As String
    Dim CPath As ClsPath
    Set CPath = New ClsPath
    If blnSlash = True Then
        GetProgramFilesPath = CPath.GetProgramFilesDir & "\"
    Else
        GetProgramFilesPath = CPath.GetProgramFilesDir
    End If
    Set CPath = Nothing
End Property
'
'âfâXâNâgâbâvé╠ê╩Æué≡ĵô╛é╡é▄é╖üB
'
Public Property Get GetDeskTopPath(Optional ByVal blnSlash As Boolean = True) As String
    Dim CPath As ClsPath
    Set CPath = New ClsPath
    If blnSlash = True Then
        GetDeskTopPath = CPath.GetDesktop & "\"
    Else
        GetDeskTopPath = CPath.GetDesktop
    End If
    Set CPath = Nothing
End Property
'
'â}âCâhâLâàâüâôâgé╠ê╩Æué≡ĵô╛é╡é▄é╖üB
'
Public Property Get GetMyDocumentPath(Optional ByVal blnSlash As Boolean = True) As String
    Dim CPath As ClsPath
    Set CPath = New ClsPath
    If blnSlash = True Then
        GetMyDocumentPath = CPath.GetMyDocument & "\"
    Else
        GetMyDocumentPath = CPath.GetMyDocument
    End If
    Set CPath = Nothing
End Property
'
'âåü[âUü[é╠PCé╔âCâôâXâgü[âïé│éΩé─éóéΘWindowsé╠Äφù▐é≡ĵô╛é╡é▄é╖üB
'
Public Function GetOSVer() As String
    Dim CInfo As ClsSysInfo
    Set CInfo = New ClsSysInfo

    GetOSVer = CInfo.GetWinVersion

    Set CInfo = Nothing
End Function
'
'âåü[âUü[é╠PCé╔âCâôâXâgü[âïé│éΩé─éóéΘInternetExploreré╠âoü[âWâçâôé≡ĵô╛é╡é▄é╖üB
'
Public Function GetIEVer() As String
    Dim CInfo As ClsSysInfo
    Set CInfo = New ClsSysInfo

    GetIEVer = CInfo.GetIEVersion

    Set CInfo = Nothing
End Function
'
'ÄwÆΦé╡é╜âhâëâCâué╠ï≤é½ùeù╩é≡ĵô╛é╡é▄é╖üB
'
Public Function GetDriveVolume(ByVal strDriveRoot As String) As Long
    On Error GoTo ErrLine
    Dim CInfo As ClsSysInfo
    Set CInfo = New ClsSysInfo

    With CInfo
        .strFileName = Left$(strDriveRoot, 3)
        GetDriveVolume = .GetDriveFreeSpace
    End With

    Set CInfo = Nothing
    Exit Function
ErrLine:
    Set CInfo = Nothing
    GetDriveVolume = -1
End Function
'
'âtâ@âCâïé╠û╝æOé≡ò╧ìXé╡é▄é╖üB
'
Public Function ChangeFileName(ByVal strBefore As String, ByVal strAfter As String) As Boolean
    On Error GoTo ErrLine
    Name strBefore As strAfter
    ChangeFileName = True
    Exit Function
ErrLine:
    ChangeFileName = False
End Function
'
'[âtâHâïâ_é╠æIæ≡]â_âCâAâìâOé≡ò\Īé╡é▄é╖üBé╚é¿üAûûö÷é╔"\"é¬Ä⌐ô«ôIé╔òtë┴é│éΩé▄é╖üB
'
Public Function GetFolderDialogPath(ByVal hWnd As Long, ByVal strTitle As String) As String
    Dim CShell As ClsShell
    Set CShell = New ClsShell

    With CShell
        .TargethWnd = hWnd
        GetFolderDialogPath = .OpenFolderDialog(strTitle)
    End With

    Set CShell = Nothing
End Function
'
'âtâ@âCâïé╠æIæ≡â_âCâAâìâOé≡ò\Īé╡é▄é╖üB
'
Public Function GetOpenFileDialogPath(ByVal hWnd As Long, ByVal strFilter As String, ByVal strDef As String, ByVal strTitle As String) As String
    Dim CShell As ClsShell
    Set CShell = New ClsShell

    With CShell
        .TargethWnd = hWnd
        GetOpenFileDialogPath = .OpenFileDialog(strFilter, strDef, strTitle)
    End With

    Set CShell = Nothing
End Function
'
'Åæî╔âtâ@âCâïé╠Äφù▐é≡Æ▓é╫é▄é╖üBé▒é┐éτé═üAâTü[â`âoâbâtâ@é≡ÄwÆΦé╖éΘé▒é╞é¬é┼é½é▄é╖üB
'
Public Function GetFileTypeSearch(ByVal strFileName As String, ByVal hWnd As Long, Optional ByVal BufSize As Long = 131072) As Long
    Dim CFile As ClsFile
    Set CFile = New ClsFile

    With CFile
        .strFileName = strFileName
        .TargethWnd = hWnd
        GetFileTypeSearch = .GetArcSearch(BufSize)
    End With
    Set CFile = Nothing
End Function
'
'ò¬èäâtâ@âCâïé╠Äφù▐é≡ô┴ÆΦé╡é▄é╖üB
'
Public Function GetDivFileTypeSearch(ByVal strFileName As String) As Long
    Dim CCmb As ClsCmbFile
    Set CCmb = New ClsCmbFile

    With CCmb
        .strFileName = strFileName
        GetDivFileTypeSearch = .DivCheckFile
    End With

    Set CCmb = Nothing
End Function
'
'âtâ@âCâïé≡ì∞ɼé╡é▄é╖üB
'
Public Sub WriteFile(ByVal strBuffer As String, ByVal strOutPut As String, Optional ByVal blnOverWrite As Boolean = True)
    Dim CFile As ClsFile
    Set CFile = New ClsFile
    Debug.Print strOutPut
    With CFile
        .strOutPut = strOutPut
        Call .WriteBufferToFile(strBuffer, blnOverWrite)
    End With

    Set CFile = Nothing
End Sub
'
'
'
Public Property Get GetDivDialog() As Long
    Dim lngResult As Long

    lngResult = IniReadByLong("ArcSetting_02", "DivDialog")

    Select Case lngResult
        Case 0, 1
            GetDivDialog = lngResult
        Case Else
            GetDivDialog = 0
    End Select
End Property
'
'
'
Public Property Get GetArcDialog() As Long
    Dim lngResult As Long

    lngResult = IniReadByLong("ArcSetting_02", "ArcDialog")

    Select Case lngResult
        Case 0, 1
            GetArcDialog = lngResult
        Case Else
            GetArcDialog = 0
    End Select
End Property
'
'
'
Public Property Get UnlhaListCommand() As String
    Dim lngResult As Long

    lngResult = IniReadByLong("ListFile", "UnlhaListMode")

    Select Case lngResult
        Case 0
            UnlhaListCommand = "l"
        Case 1
            UnlhaListCommand = "v"
        Case Else
            UnlhaListCommand = "v"
    End Select

End Property
'
'
'
Public Property Get UnZipListCommand() As String
    Dim lngResult As Long

    lngResult = IniReadByLong("ListFile", "UnZipListMode")

    Select Case lngResult
        Case 0
            UnZipListCommand = "-l"
        Case 1
            UnZipListCommand = "-lv"
        Case 2
            UnZipListCommand = "-v"
        Case Else
            UnZipListCommand = "-v"
    End Select
End Property
'
'
'
Public Property Get CabListCommand() As String
    CabListCommand = "-l"
End Property
'
'
'
Public Property Get UnArjListCommand() As String
    Dim lngResult As Long

    lngResult = IniReadByLong("ListFile", "UnArjListMode")

    Select Case lngResult
        Case 0
            UnArjListCommand = "l"
        Case 1
            UnArjListCommand = "v"
        Case 2
            UnArjListCommand = "lv"
        Case 3
            UnArjListCommand = "vv"
        Case Else
            UnArjListCommand = "v"
    End Select

End Property
'
'
'
Public Property Get UnlhaCommand() As String
    Dim strCommand As String
    Dim lngResult As Long

    lngResult = IniReadByLong("ArcSetting_02", "UnlhaFileElement")

    If lngResult = 1 Then
        strCommand = " -a0"
    Else
        strCommand = " -a1"
    End If

    lngResult = IniReadByLong("ArcSetting_02", "UnlhaAllQYes")

    If lngResult = 1 Then
        strCommand = strCommand & " -y1"
    End If


    lngResult = IniReadByLong("ArcSetting_02", "UnlhaUnExistFile")

    If lngResult = 1 Then
        strCommand = strCommand & " -u1"
    End If

    lngResult = IniReadByLong("ArcSetting_02", "UnlhaIgnoreErr")

    If lngResult = 1 Then
        strCommand = strCommand & " -jc1"
    End If

    lngResult = IniReadByLong("ArcSetting_02", "UnlhaAllErrYes")

    If lngResult = 1 Then
        strCommand = strCommand & " -gm1"
    End If

    lngResult = IniReadByLong("ArcSetting_02", "UnlhaReadOnly")

    If lngResult = 1 Then
        strCommand = strCommand & " -ga1"
    End If

    UnlhaCommand = "x -m1 -x1 -jf0 -n1 -gp0" & strCommand
    Debug.Print "UnlhaCommand: " & UnlhaCommand
End Property
'
'
'
Public Property Get UnZipCommand() As String
    Dim strCommand As String
    Dim lngResult As Long

    lngResult = IniReadByLong("ArcSetting_01", "UnZipIgnoreFolder")

    If lngResult = 1 Then
        strCommand = strCommand & " -j"
    End If

    lngResult = IniReadByLong("ArcSetting_01", "UnZipNotOverWrite")

    If lngResult = 1 Then
        strCommand = strCommand & " -n"
    End If

    lngResult = IniReadByLong("ArcSetting_01", "UnZipOverWrite")

    If lngResult = 1 Then
        strCommand = strCommand & " -o"
    End If

    lngResult = IniReadByLong("ArcSetting_01", "UnZipSilentInfo")

    If lngResult = 1 Then
        strCommand = strCommand & " -qq"
    End If

    UnZipCommand = "-x --i" & strCommand
    Debug.Print "UnZipCommand: " & UnZipCommand
End Property
'
'
'
Public Property Get CabCommand() As String
    Dim strCommand As String
    Dim lngResult As Long

    lngResult = IniReadByLong("ArcSetting_01", "Cab32IgnoreFolder")

    If lngResult = 1 Then
        strCommand = strCommand & " -j"
    End If

    lngResult = IniReadByLong("ArcSetting_01", "Cab32UnExistFile")

    If lngResult = 1 Then
        strCommand = strCommand & " -n"
    End If

    lngResult = IniReadByLong("ArcSetting_01", "Cab32OverWrite")

    If lngResult = 1 Then
        strCommand = strCommand & " -o"
    End If

    CabCommand = "-x -i" & strCommand
    Debug.Print "CabCommand: " & CabCommand
End Property
'
'
'
Public Property Get UnArjCommand() As String
    Dim strCommand As String
    Dim lngResult As Long

    lngResult = IniReadByLong("ArcSetting_01", "UnArjExistFile")

    If lngResult = 1 Then
        strCommand = " -f+"
    End If

    lngResult = IniReadByLong("ArcSetting_01", "UnArjUnExistFile")

    If lngResult = 1 Then
        strCommand = strCommand & " -n+"
    End If

    lngResult = IniReadByLong("ArcSetting_01", "UnArjAllQYes")

    If lngResult = 1 Then
        strCommand = strCommand & " -y+"
    End If

    lngResult = IniReadByLong("ArcSetting_01", "UnArjIgnoreErr")

    If lngResult = 1 Then
        strCommand = strCommand & " -jr+"
    End If

    lngResult = IniReadByLong("ArcSetting_01", "UnArjAllErrYes")

    If lngResult = 1 Then
        strCommand = strCommand & " -hm+"
    End If

    UnArjCommand = "x -i+" & strCommand
    Debug.Print "UnArjCommand: " & UnArjCommand
End Property
'
'
'
Public Property Get UnGCACommand() As String
    Dim strCommand As String
    Dim lngResult As Long

    lngResult = IniReadByLong("ArcSetting_01", "UnGCAAllQYes")

    If lngResult = 1 Then
        strCommand = " -yx0"
    Else
        strCommand = " -yx1"
    End If

    lngResult = IniReadByLong("ArcSetting_01", "UnGCADialog")

    If lngResult = 1 Then
        strCommand = strCommand & " -sx0"
    Else
        strCommand = strCommand & " -sx1"
    End If

    UnGCACommand = "e" & strCommand
    Debug.Print "UnGCACommand: " & strCommand
End Property
'
'
'
Public Property Get BgaCommand() As String
    Dim strCommand As String
    Dim lngResult As Long

    lngResult = IniReadByLong("ArcSetting_01", "Bga32AllElement")

    If lngResult = 1 Then
        strCommand = ""
    Else
        strCommand = " -a"
    End If

    lngResult = IniReadByLong("ArcSetting_01", "Bga32IgnoreFolder")

    If lngResult = 1 Then
        strCommand = strCommand & " -j"
    End If

    lngResult = IniReadByLong("ArcSetting_01", "Bga32UnExistFile")

    If lngResult = 1 Then
        strCommand = strCommand & " -n"
    End If

    lngResult = IniReadByLong("ArcSetting_01", "Bga32OverWrite")

    If lngResult = 1 Then
        strCommand = strCommand & " -o"
    End If

    lngResult = IniReadByLong("ArcSetting_01", "Bga32SubSearch")

    If lngResult = 1 Then
        strCommand = strCommand & " -r"
    End If

    BgaCommand = "x -i" & strCommand
    Debug.Print "BgaCommand: " & BgaCommand
End Property
'
'
'
Public Property Get Yz1Command() As String
    Dim strCommand As String
    Dim lngResult As Long

    lngResult = IniReadByLong("ArcSetting_01", "Yz1AllQYes")

    If lngResult = 1 Then
        strCommand = " -y"
    End If

    Yz1Command = "x -i" & strCommand
    Debug.Print "Yz1Command: " & strCommand
End Property
'
'
'
Public Property Get TarCommand() As String
    TarCommand = "-xvf"
End Property
'
'âèâXâgâtâ@âCâïé≡ì∞ɼé╖éΘì█üAâtâ@âCâïâTâCâYé╠Åπî└é≡ĵô╛é╡é▄é╖üB
'
Public Property Get GetBufferSize() As Long
    Dim lngResult As Long
    Dim strBufSize As String

    lngResult = IniReadByLong("ListFile", "ListFileSize")

    Select Case lngResult
        Case 0
            GetBufferSize = 65536
        Case 1
            strBufSize = IniReadByLong("ListFile", "ListFileBufSize")
            If IsNumeric(strBufSize) = True Then
                GetBufferSize = CLng(strBufSize)
            Else
                GetBufferSize = 65536
            End If
        Case Else
            GetBufferSize = 65536
    End Select
End Property
'
'âèâXâgâtâ@âCâïé╠ëⁿìsâRü[âhé╠Äφù▐é≡ĵô╛é╡é▄é╖üB
'
Public Property Get GetLineCode() As Long
    Dim lngResult As Long

    lngResult = IniReadByLong("ListFile", "LineCode")

    Select Case lngResult
        Case 0, 1, 2
            GetLineCode = lngResult
        Case Else
            GetLineCode = 0
    End Select
End Property
'
'âèâXâgâtâ@âCâïé≡ì∞ɼé╡é▄é╖üB
'
Public Sub ArcListFile(ByVal strFileName As String, ByVal hWnd As Long, ByVal strOutPut As String, ByVal lngType As Long)
    Dim CArcCmd As ClsArcCmd
    Set CArcCmd = New ClsArcCmd
    Dim strBuffer As String

    With CArcCmd
        .BufferSize = GetBufferSize
        .strFileName = strFileName
        .strOutPut = vbNullString
        .TargethWnd = hWnd
    End With

    Select Case lngType
        Case 1
            With CArcCmd
                .strCommand = UnlhaListCommand
                .CommandUnlha
            End With
        Case 2
            With CArcCmd
                .strCommand = UnZipListCommand
                .CommandUnZip
            End With
        Case 3
            With CArcCmd
                .strCommand = CabListCommand
                .CommandCab
            End With
        Case 8
            With CArcCmd
                .strCommand = UnArjListCommand
                .CommandUnArj
            End With
    End Select
    If CArcCmd.ResultBuffer <> "" Then
        Call CreateMkDir(GetPathName(strOutPut))
        Select Case lngType
            Case 2
                Select Case GetLineCode
                    Case 0
                        strBuffer = ReplaceChar(CArcCmd.ResultBuffer, vbLf, vbCrLf)
                    Case 1
                        strBuffer = CArcCmd.ResultBuffer
                    Case 2
                        strBuffer = ReplaceChar(CArcCmd.ResultBuffer, vbLf, vbCr)
                End Select

                Select Case GetListFileOverWrite
                    Case 0
                        Call WriteFile(strBuffer, strOutPut, True)
                    Case 1
                        Call WriteFile(strBuffer, strOutPut, False)
                End Select
            Case Else
                Select Case GetListFileOverWrite
                    Case 0
                        Call WriteFile(CArcCmd.ResultBuffer, strOutPut, True)
                    Case 1
                        Call WriteFile(CArcCmd.ResultBuffer, strOutPut, False)
                End Select
        End Select
    End If

    Set CArcCmd = Nothing
End Sub
'
'Åæî╔é╠É│ôûɽîƒì╕é≡ìséóé▄é╖üB
'
Public Function ArcExamFile(ByVal strFileName As String, ByVal hWnd As Long, ByVal lngType As Long) As String
    Dim strBuffer As String
    Dim CArcCmd As ClsArcCmd
    Set CArcCmd = New ClsArcCmd

    With CArcCmd
        .strFileName = strFileName
        .strOutPut = vbNullString
        .TargethWnd = hWnd
    End With

    Select Case lngType
        Case 1
            CArcCmd.TestUnlha
        Case 2
            CArcCmd.TestUnZip
        Case 3
            CArcCmd.TestCab
        Case 4
            If CArcCmd.IsRarPass = 2 Then
                strBuffer = InputDialog("âpâXâÅü[âhôⁿù═", "âpâXâÅü[âhé≡ôⁿù═é╡é─é¡é╛é│éó", True)
            End If
            CArcCmd.TestRar
        Case 5
            CArcCmd.TestBga
        Case 7
            If CArcCmd.IsAcePass = 131 Then
                strBuffer = InputDialog("âpâXâÅü[âhôⁿù═", "âpâXâÅü[âhé≡ôⁿù═é╡é─é¡é╛é│éó", True)
            End If
            CArcCmd.TestAce
        Case 8
            CArcCmd.TestArj
        Case 11
            CArcCmd.TestTar
    End Select

    mGetErrorNum = CArcCmd.GetErrorNumber

    If CArcCmd.ResultBuffer <> "" Then
        ArcExamFile = "üy" & strFileName & "üz" & vbCrLf & ReplaceChar(CArcCmd.ResultBuffer, vbLf, vbCrLf) & vbCrLf
    Else
        ArcExamFile = "üy" & strFileName & "üz" & vbCrLf & "ü¿É│ôûɽîƒì╕é═Åoùêé▄é╣é±üB" & vbCrLf
    End If

    Set CArcCmd = Nothing
End Function
'
'âtâ@âCâïé≡îïìçé╡é▄é╖üB
'
Public Sub FileCombine(ByVal strFileName As String, ByVal hWnd As Long, ByVal strOutPut As String, ByVal lngType As Long)
    Dim CCmb As ClsCmbFile
    Set CCmb = New ClsCmbFile

    With CCmb
        .TargethWnd = hWnd
        .strFileName = strFileName
        .strOutPut = strOutPut
    End With

    Select Case lngType
        Case 50
            CCmb.FileCombineJydiv1
        Case 51
            CCmb.FileCombineJydiv2
        Case 52
            CCmb.FileCombineJydiv3
        Case 53
            CCmb.FileCombineRiz
        Case 54
            CCmb.FileCombineBunkatsuKun
        Case 55, 56, 57, 58
            CCmb.FileCombine
    End Select

    Set CCmb = Nothing
End Sub
'
'âtâ@âCâïé≡ë≡ôÇé╡é▄é╖üB
'
Public Function ArcCommand(ByVal strFileName As String, ByVal hWnd As Long, ByVal strOutPut As String, ByVal lngType As Long) As String
    Dim strPassWord As String
    Dim CArcCmd As ClsArcCmd
    Set CArcCmd = New ClsArcCmd
    Select Case lngType
        Case 0, 20, 200

        Case Else
            Call CreateMkDir(strOutPut)
    End Select

    With CArcCmd
        .strFileName = strFileName
        .strOutPut = SetQuote(strOutPut)
        .TargethWnd = hWnd
    End With

    If lngType = 9 Then
        With CArcCmd
            .strFileName = GetShortPath(strFileName)
            .strOutPut = GetShortPath(strOutPut)
        End With
    End If

    Select Case lngType
        Case 1
            Call SetOwnerWindow(hWnd, 1)
            With CArcCmd
                .strCommand = UnlhaCommand
                .CommandUnlha
            End With
            Call KillOwnerWindow(hWnd, 1)
        Case 2
            Call SetOwnerWindow(hWnd, 2)
            With CArcCmd
                .strCommand = UnZipCommand
                .CommandUnZip
            End With
            Call KillOwnerWindow(hWnd, 2)
        Case 3
            Call SetOwnerWindow(hWnd, 3)
            With CArcCmd
                .strCommand = CabCommand
                .CommandCab
            End With
            Call KillOwnerWindow(hWnd, 3)
        Case 4
            If GetArcDialog = 1 Then
                CArcCmd.TargethWnd = 0
            End If
            If CArcCmd.IsRarPass = 2 Then
                strPassWord = InputDialog("âpâXâÅü[âhôⁿù═", "âpâXâÅü[âhé≡ôⁿù═é╡é─é¡é╛é│éó", True)
            End If
            With CArcCmd
                .strOutPut = strOutPut
                .CommandUnrar (strPassWord)
            End With
        Case 5
            Call SetOwnerWindow(hWnd, 4)
            With CArcCmd
                .strCommand = BgaCommand
                .CommandBga
            End With
            Call SetOwnerWindow(hWnd, 4)
        Case 6
            Call SetOwnerWindow(hWnd, 7)
            With CArcCmd
                .strCommand = Yz1Command
                .CommandYz1
            End With
            Call KillOwnerWindow(hWnd, 7)
        Case 7
            If GetArcDialog = 1 Then
                CArcCmd.TargethWnd = 0
            End If
            If CArcCmd.IsAcePass = 131 Then
                strPassWord = InputDialog("âpâXâÅü[âhôⁿù═", "âpâXâÅü[âhé≡ôⁿù═é╡é─é¡é╛é│éó", True)
            End If
            With CArcCmd
                .strOutPut = strOutPut
                .CommandUnAce (strPassWord)
            End With
        Case 8
            Call SetOwnerWindow(hWnd, 6)
            With CArcCmd
                .strCommand = UnArjCommand
                .CommandUnArj
            End With
            Call KillOwnerWindow(hWnd, 6)
        Case 9
            With CArcCmd
                .strCommand = "/f="
                .CommandIsh
            End With
        Case 10
            With CArcCmd
                .strCommand = UnGCACommand
                .CommandUnGca
            End With
        Case 11
            'Call SetOwnerWindow(hWnd, 5)
            With CArcCmd
                .strCommand = TarCommand
                .CommandTar
            End With
            'Call KillOwnerWindow(hWnd, 5)
        Case 12
            CArcCmd.CommandLz
        Case 50, 51, 52, 53, 54, 55, 56, 57, 58
            If GetDivDialog = 1 Then
                Call FileCombine(strFileName, 0, strOutPut & GetRevPathExt(strFileName), lngType)
            Else
                Call FileCombine(strFileName, hWnd, strOutPut & GetRevPathExt(strFileName), lngType)
            End If
    End Select

    Debug.Print CArcCmd.DebugString
    Debug.Print CArcCmd.GetErrorString

    If CArcCmd.GetErrorNumber <> 0 Then
        ArcCommand = CArcCmd.GetErrorString
    End If

    Set CArcCmd = Nothing
End Function
'
'âtâ@âCâïé≡ÆPë≡ôÇé╡é▄é╖üB
'
Public Function ArcSingleCommand(ByVal strFileName As String, ByVal hWnd As Long, ByVal strOutPut As String, Optional ByVal strResponseFile As String = "") As String
    Dim CArcCmd As ClsArcCmd
    Set CArcCmd = New ClsArcCmd

    Select Case lngCheckType
        Case 0, 20, 200

        Case Else
            Call CreateMkDir(strOutPut)
    End Select

    With CArcCmd
        .strFileName = strFileName
        .strOutPut = strOutPut
        .strWildCard = strResponseFile
        .TargethWnd = hWnd
    End With

    Select Case lngCheckType
        Case 1
            With CArcCmd
                .strCommand = "e -a1 -x0 -m1 -u0"
                .CommandUnlha
            End With
        Case 2
            With CArcCmd
                .strCommand = "-x -j -o"
                .CommandUnZip
            End With
        Case 3
            With CArcCmd
                .strCommand = "-x -j -o"
                .CommandCab
            End With
        Case 5
            With CArcCmd
                .strCommand = "x -a -j -o"
                .CommandBga
            End With
        Case 8
            With CArcCmd
                .strCommand = "e"
                .CommandUnArj
            End With
        Case 9
            With CArcCmd
                .strCommand = "/Y " & strResponseFile & " /f="
                .CommandIsh
            End With
        Case 11
            With CArcCmd
                .strCommand = "-x"
                .CommandTar
            End With
        Case Else
            MsgBoxEx "É\é╡û≤éáéΦé▄é╣é±é¬é▄é╛âTâ|ü[âgé│éΩé─éóé▄é╣é±üBéì(_ _)éì", vbInformation
    End Select

    Debug.Print CArcCmd.DebugString

    If CArcCmd.GetErrorNumber <> 0 Then
        ArcSingleCommand = CArcCmd.GetErrorString
    End If

    Set CArcCmd = Nothing
End Function
'
'èiö[âtâ@âCâïÉöé≡ĵô╛é╡é▄é╖üB
'
Public Function GetArcCount(ByVal strFileName As String, ByVal hWnd As Long) As Long
    Dim CFile As ClsFile
    Set CFile = New ClsFile

    With CFile
        .strFileName = strFileName
        .TargethWnd = hWnd
    End With

    Select Case lngCheckType
        Case 1
            GetArcCount = CFile.GetCountUnlha
        Case 2
            GetArcCount = CFile.GetCountUnZip
        Case 3
            GetArcCount = CFile.GetCountCab
        Case 4
            GetArcCount = CFile.GetCountUnRar
        Case 5
            GetArcCount = CFile.GetCountBga
        Case 6
            GetArcCount = CFile.GetCountYz1
        Case 7
            GetArcCount = CFile.GetCountUnAce
        Case 8
            GetArcCount = CFile.GetCountUnArj
        Case 9
            GetArcCount = 0
        Case 10
            GetArcCount = CFile.GetCountUnGCA
        Case 11
            GetArcCount = CFile.GetCountTar
        Case 12
            GetArcCount = 1
    End Select
    Set CFile = Nothing

End Function
Public Property Get GetArcErrorNumber() As Long
    GetArcErrorNumber = mGetErrorNum
End Property
'
'î╗ì▌é╠ô·òté╞Ä₧ìÅé≡ĵô╛é╡é▄é╖üBYYYYMMDDHHMMSS
'
Public Property Get GetNowTime() As String
    Dim CInfo As ClsSysInfo
    Set CInfo = New ClsSysInfo

    GetNowTime = CInfo.GetNowDateTime

    Set CInfo = Nothing
End Property
Public Property Get GetListFileOverWrite() As Long
    Dim lngResult As Long

    lngResult = IniReadByLong("ListFile", "QOverWrite")

    Select Case lngResult
        Case 0, 1
            GetListFileOverWrite = lngResult
        Case Else
            GetListFileOverWrite = 0
    End Select
End Property